perm filename MN[CMS,LCS] blob
sn#445213 filedate 1979-05-27 generic text, type T, neo UTF8
00100 ;LANGUAGE COMPATIBILITY FLAGS.
00200 IFNDEF SAIL,< ↓SAIL←← 0 ;-1 FOR SAIL EMBEDDED VERSION.>
00300 IFNDEF LISP,< ↓LISP←← 0 ;-1 FOR LISP EMBEDDED VERSION.>
00400 IFE (SAIL∨LISP){DEFINE EX.{}}
00500 IFN (SAIL∨LISP){DEFINE EX.{SOSGE ENTERS↑↔JSR EXIT.↑}}
00600
00700 ;ALTERNATE PDP-10 MNEMONICS.
00800 OPDEF DIP[HRLM]↔OPDEF DAP[HRRM]
00900 OPDEF CAR[HLRZ]↔OPDEF CDR[HRRZ]
01000 OPDEF LAC[MOVE]↔OPDEF DAC[MOVEM]↔OPDEF GO[JRST]
01100 OPDEF FLOAT[FSC 233]↔OPDEF FIXX[KAFIX 233000]
01200
01300 ;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
01400 ↓P←←17
01500 ↓POP0J.:EX.↔POPJ P, ↔DEFINE POP0J<GO POP0J.>
01600 ↓POP1J.:EX.↔SUB P,[2(2)]↔GO@2(P)↔DEFINE POP1J<GO POP1J.>
01700 ↓POP2J.:EX.↔SUB P,[3(3)]↔GO@3(P)↔DEFINE POP2J<GO POP2J.>
01800 ↓POP3J.:EX.↔SUB P,[4(4)]↔GO@4(P)↔DEFINE POP3J<GO POP3J.>
01900 ↓POP4J.:EX.↔SUB P,[5(5)]↔GO@5(P)↔DEFINE POP4J<GO POP4J.>
02000
02100 ;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
02200 DEFINE ACCUMULATORS(LIST){ACPTR←←2 ;DECLARE ACCUMULATORS.
02300 FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
02400 FOR @$ I←0,16<AC.$I←I↔> ;ACCUMULATOR NAMES FOR RAID.
02500 DEFINE DECLARE (LIST){
02600 FOR VARNAM⊂(LIST)<VARNAM:0↔>}
02700
02800 ;MACROS TO SAVE AND RESTORE AC'S - SAVAC, GETAC.
02900 DEFINE SAVAC $(N){LAC[XWD 2,[AC2: FOR I←2,N{0↔}]]↔BLT AC2+N-2}
03000 DEFINE GETAC (N){LAC[XWD AC2,2]↔BLT N}
03100
03200 ;FATAL ERROR MESSAGE.
03300 DEFINE FATAL(STR){PUSHJ P,FATAL.↑↔JFCL[ASCIZ|STR|]}
03400 DEFINE WARNING(STR){PUSHJ P,WARN.↑↔JFCL[ASCIZ|STR|]}
03500 DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
00100 ;SAIL LIKE SUBROUTINE LINKAGE.
00200 DEFINE CAT $(A,B){A$B} ;CONCATENATION.
00300 .PLEVEL←←0 ;PDL BACK POINTER.
00400 .SLEVEL←←0 ;DEPTH OF NESTED SUBROUTINE DECLARATIONS.
00500
00600 ;SUBROUTINE DECLARATION MACROS - SUBR & ENDR.
00700 ;(Reminder: Right-arrow, "→" is FAIL's macro arg EVAL).
00800 DEFINE SUBR(NAME,X1,X2,X3,X4,X5)↔{BEGIN NAME↔INTERN NAME
00900 GLOBAL .PLEVEL↔GLOBAL .SLEVEL↔.SLEVEL←←.SLEVEL+1
01000 CAT(.SBR,→.SLEVEL)←←.PLEVEL ↔.PLEVEL←←.PLEVEL+1
01100 IFDIF<><X1>{DEFARG(X1,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
01200 IFDIF<><X2>{DEFARG(X2,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
01300 IFDIF<><X3>{DEFARG(X3,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
01400 IFDIF<><X4>{DEFARG(X4,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
01500 IFDIF<><X5>{DEFARG(X5,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1}}}}}
01600 XWD 777000+.PLEVEL-CAT(.SBR,→.SLEVEL)-1,[SIXBIT|NAME|]
01700 ↓NAME:IFN(SAIL∨LISP){AOSG ENTERS↑↔JSR ENTRY.↑};}
01800
01900 ;SUBN - NOT INTERN'ED SUBROUTINE.
02000 DEFINE SUBN(NAME,X1,X2,X3,X4,X5)↔{BEGIN NAME
02100 GLOBAL .PLEVEL↔GLOBAL .SLEVEL↔.SLEVEL←←.SLEVEL+1
02200 CAT(.SBR,→.SLEVEL)←←.PLEVEL ↔.PLEVEL←←.PLEVEL+1
02300 IFDIF<><X1>{DEFARG(X1,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
02400 IFDIF<><X2>{DEFARG(X2,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
02500 IFDIF<><X3>{DEFARG(X3,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
02600 IFDIF<><X4>{DEFARG(X4,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
02700 IFDIF<><X5>{DEFARG(X5,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1}}}}}
02800 XWD 777000+.PLEVEL-CAT(.SBR,→.SLEVEL)-1,[SIXBIT|NAME|]
02900 ↑NAME:IFN(SAIL∨LISP){AOS ENTERS↑};}
03000
03100 ;DEFINE ARGUMENT NAME MACRO.
03200 DEFINE DEFARG(NAME,LEVEL){DEFINE NAME{LEVEL-.PLEVEL(17)}}
03300 ;SUBROUTINE TERMINATION MACRO.
03400 DEFINE ENDR{.PLEVEL←←CAT(.SBR,→.SLEVEL)
03500 .SLEVEL←←.SLEVEL-1↔LIT↔BLOCK 0↔IFN SAIL{XPUNGE}↔BEND }
03600
03700 ;SUBROUTINE CALLING MACROS - CALL & SETQ.
03800 DEFINE CALL(NAME,X1,X2,X3,X4,X5)
03900 {GLOBAL .SLEVEL,.PLEVEL↔.SLEVEL←←.SLEVEL+1
04000 CAT(.SBR,→.SLEVEL)←←.PLEVEL
04100 IFDIF<><X1>{PUSH P,X1↔.PLEVEL←.PLEVEL+1
04200 IFDIF<><X2>{PUSH P,X2↔.PLEVEL←.PLEVEL+1
04300 IFDIF<><X3>{PUSH P,X3↔.PLEVEL←.PLEVEL+1
04400 IFDIF<><X4>{PUSH P,X4↔.PLEVEL←.PLEVEL+1
04500 IFDIF<><X5>{PUSH P,X5↔.PLEVEL←.PLEVEL+1 }}}}}
04600 IFDIF<><NAME>{PUSHJ P,NAME }
04700 .PLEVEL←←CAT(.SBR,→.SLEVEL)↔.SLEVEL←←.SLEVEL-1}
04800 DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}
04900
05000 ;STACK ACCESSING MACROS - PUSHP & POPP.
05100 DEFINE PUSHP(ARG){PUSH P,ARG↔.PLEVEL←←.PLEVEL+1}
05200 DEFINE POPP(ARG) {POP P,ARG↔.PLEVEL←←.PLEVEL-1}
00100 ;LINK MACROS
00200 DEFINE LEFT $(NAM,WRD,Z){
00300 IFIDN<><Z><DEFINE NAM(A,Q)<HLRZ A,WRD(Q)>>
00400 IFDIF<><Z><DEFINE NAM(A,Q)<HLRE A,WRD(Q)>>
00500 DEFINE NAM$.(A,Q)<HRLM A,WRD(Q)>}
00600
00700 DEFINE RIGHT $(NAM,WRD,Z){
00800 IFIDN<><Z><DEFINE NAM(A,Q)<HRRZ A,WRD(Q)>>
00900 IFDIF<><Z><DEFINE NAM(A,Q)<HRRE A,WRD(Q)>>
01000 DEFINE NAM$.(A,Q)<HRRM A,WRD(Q)>}
01100
01200 ;DEFINE GEM LINK NAMES.
01300
01400 LEFT(X1DC,-3,N)↔ RIGHT(Y1DC,-3,N)
01500 LEFT(X2DC,-2,N)↔ RIGHT(Y2DC,-2,N)
01600 LEFT(TYPE,0)
01700 DEFINE $TYPE(Q,E)<LDB Q,[POINT 4,(E),35]>
01800
01900 LEFT(NFACE,1)↔ RIGHT(PFACE,1)
02000 LEFT(NED,2)↔ RIGHT(PED,2)↔ LEFT(NCNT,2,N)
02100 LEFT(NVT,3)↔ RIGHT(PVT,3)
02200 LEFT(NCW,4)↔ RIGHT(PCW,4)
02300 LEFT(DAD,4)↔ RIGHT(SON,4)
02400 LEFT(NWRLD,4)↔ RIGHT(PWRLD,4)
02500 LEFT(NCAMR,4)↔ RIGHT(PCAMR,4)
02600 LEFT(NCCW,5)↔ RIGHT(PCCW,5)
02700 LEFT(NTIME,5)↔ RIGHT(PTIME,5)
02800 LEFT(BRO,5)↔ RIGHT(SIS,5)
02900 LEFT(ALT,6)↔ RIGHT(ALT2,6)
03000 RIGHT(FRAME,6)↔ RIGHT(POTEN,6)
03100 LEFT(CW,7)↔ RIGHT(CCW,7)
03200 LEFT(SIMAG,7)↔ RIGHT(PIMAG,7)↔ LEFT(UFACE,7,N)
03300 LEFT(NUF,8)↔ RIGHT(PUF,8)
03400
03500 DEFINE XDC(A,B) {HLLE A,1(B)}↔ DEFINE YDC(A,B) {HRLE A,1(B)}
03600 DEFINE XDC.(A,B){HLLM A,1(B)}↔ DEFINE YDC.(A,B){HLRM A,1(B)}
00100 ; NAMES OF NODE DATA WORDS.
00200
00300 ↓AA ←← ↓XWC ←← -3
00400 ↓BB ←← ↓YWC ←← -2
00500 ↓CC ←← ↓ZWC ←← -1
00600
00700 ↓QQ ←← 7
00800 ↓KK ←← 3
00900
01000 ↓XPP ←← 4↔ ↓YPP ←← 5↔ ↓ZPP ←← 6
01100 ↓IX←←0↔ ↓IY←←1↔ ↓IZ←←2
01200 ↓JX←←3↔ ↓JY←←4↔ ↓JZ←←5
01300 ↓KX←←6↔ ↓KY←←7↔ ↓KZ←←8
01400
01500 ;NODE SERIAL TYPE NUMBERS.
01600
01700 ↓$FRAME ←← 0
01800 ↓$EMPTY ←← 1
01900 ↓$UNIVERSE ←← 2
02000 ↓$SUN ←← 3
02100
02200 ↓$CAMERA ←← 4
02300 ↓$WORLD ←← 5
02400 ↓$WINDOW ←← 6
02500 ↓$IMAGE ←← 7
02600
02700 ↓$TEXT ←← 10
02800 ↓$XNODE ←← 11
02900 ↓$YNODE ←← 12
03000 ↓$ZNODE ←← 13
03100
03200 ↓$BODY ←← 14
03300 ↓$FACE ←← 15
03400 ↓$EDGE ←← 16
03500 ↓$VERT ←← 17
00100 ;TYPE BIT OPERATIONS.
00200
00300 DEFINE MARK(Q,BITS){
00400 IFE <BITS>⊗-22,{MOVEI BITS}
00500 IFN <BITS>⊗-22,{MOVSI<BITS>⊗-22}
00600 IORM(Q)}
00700
00800 DEFINE MARKZ(Q,BITS){
00900 IFE <BITS>⊗-22,{MOVEI BITS}
01000 IFN <BITS>⊗-22,{MOVSI<BITS>⊗-22}
01100 ANDCAM (Q)}
01200
01300 DEFINE TEST(Q,BITS){
01400 IFDIF<><Q><LAC(Q)>
01500 IFE <BITS>⊗-22,{TRNN BITS}
01600 IFN <BITS>⊗-22,{TLNN<BITS>⊗-22}}
01700
01800 DEFINE TESTZ(Q,BITS){
01900 IFDIF<><Q><LAC(Q)>
02000 IFE <BITS>⊗-22,{TRNE BITS}
02100 IFN <BITS>⊗-22,{TLNE<BITS>⊗-22}}
02200
00100 ;PROPERTY-TYPE BITS.
00200 ↓BBIT ←← 1B17 ;BODY BIT.
00300 ↓FBIT ←← 1B16 ;FACE BIT.
00400 ↓EBIT ←← 1B15 ;EDGE BIT.
00500 ↓VBIT ←← 1B14 ;VERTEX BIT.
00600
00700 ↓PZZ ←← 1B1 ;POSITIVE Z CAMERA COORDINATES.
00800 ↓NZZ ←← 1B10 ;NEGATIVE Z IN VIEW.
00900
01000 ↓FOLDED ←← 1B11 ;FOLDED EDGE.
01100 ↓VISIBLE ←← 1B12 ;ACTUALLY VISIBLE.
01200 ↓POTENT ←← 1B13 ;POTENTIALLY VISIBLE.
01300 ↓DARKEN ←← 1B3 ;NOT TO BE INTENSIFIED.
01400 ↓NSHARP ←← 1B4 ;NOT SHARP - SMOOTH EDGE.
01500
01600 ↓NORTH ←← 1B5 ;2-D CLIPPER BITS.
01700 ↓SOUTH ←← 1B6
01800 ↓EAST ←← 1B7
01900 ↓WEST ←← 1B8
02000 ↓NSEW ←← 17B8
02100
02200 ↓JUTBIT ←← 1B3 ;JOINT UNDER T.
02300 ↓JOTBIT ←← 1B4 ;JOINT OVER T.
02400
02500 ↓TBIT3←←1B20 ;TEMPORARY BITS.
02600 ↓TBIT2←←1B19
02700 ↓TBIT1←←1B18
02800 ↓TMPBIT ←← 1B2
02900
03000 ↓BDLBIT ←← 1B1 ;BODY OPERATION DISABLE LOCOR ACTION.
03100 ↓BDVBIT ←← 1B3 ;BODY OPERATION DISABLE VERTEX ACTION.
03200 ↓BDPBIT ←← 1B4 ;BODY OPERATION DISABLE PARTS ACTION.
03300 END